home *** CD-ROM | disk | FTP | other *** search
/ The Programmer Disk / The Programmer Disk (Microforum).iso / xpro / pascal / pro9 / mouse.pas < prev    next >
Pascal/Delphi Source File  |  1988-02-17  |  7KB  |  278 lines
  1. unit mouse;
  2.  
  3.   interface
  4.     uses dos;
  5.     type array32word = array[0..31] of word;
  6.     const
  7.       hand : array32word = ($ffff,$ffff,$ffff,$ffff,$ffff,$ffff,$ffff,$ffff,
  8.                             $ffff,$ffff,$ffff,$ffff,$ffff,$ffff,$ffff,$ffff,
  9.                             $0000,$0000,$0700,$0500,$0500,$05FC,$0554,$0D54,
  10.                             $1554,$1004,$0804,$0404,$0208,$0208,$0208,$0208);
  11.     var  mouse_clicked_x,
  12.          mouse_clicked_y  : word;
  13.  
  14.     function  mouse_area   (var xma)        : word;
  15.     function  mouse_clicked(button:word)    : boolean;
  16.     function  mousex           : word;
  17.     function  mousey           : word;
  18.     function  mousebutton      : word;
  19.     function  mouse_swreset    : boolean;
  20.     procedure get_sensitivity         ( var x           : word;
  21.                                         var y           : word;
  22.                                         var speed       : word        );
  23.     procedure set_sensitivity         (     x           : word;
  24.                                             y           : word;
  25.                                             speed       : word        );
  26.     procedure physical_movement       ( var x           : integer;
  27.                                         var y           : integer     );
  28.     procedure set_ratio               (     x,y         : word        );
  29.     procedure cond_off                (     ux,uy,lx,ly : word        );
  30.     procedure set_speed2              (     threshold   : word        );
  31.     procedure mouse_cursor            (     onoff       : boolean     );
  32.     procedure mouse_position          ( var button_stat : word;
  33.                                         var x           : word;
  34.                                         var y           : word        );
  35.     procedure set_mouse_position      (     x,y         : word        );
  36.     procedure set_mouse_x_bounds      (     xl,xu       : word        );
  37.     procedure set_mouse_y_bounds      (     yl,yu       : word        );
  38.     procedure set_mouse_cursor        (     x,y         : word;
  39.                                         var point       : array32word );
  40.     procedure set_text_cursor         (     aorh,
  41.                                             startof,
  42.                                             endof       : word        );
  43.     function  mouseparams             ( var num_buttons : word        ):boolean;
  44.  
  45.     function  button_pressed          (     button      : word;
  46.                                         var count       : word;
  47.                                         var x           : word;
  48.                                         var y           : word        ):boolean;
  49.     function  button_released         (     button      : word;
  50.                                         var count       : word;
  51.                                         var x           : word;
  52.                                         var y           : word        ):boolean;
  53.  
  54.  
  55.   implementation
  56.  
  57.   function mouse_area;
  58.   var x:integer;
  59.       mx,my,button : word;
  60.       ma : array[1..100,1..4] of word absolute xma;
  61.   begin
  62.     x:=1;
  63.     mouse_position(button,mx,my);
  64.     while ma[x,1]<>0 do begin
  65.       if     (mx>=ma[x,1])
  66.          and (mx<=ma[x,2])
  67.          and (my>=ma[x,3])
  68.          and (my<=ma[x,4]) then begin
  69.         mouse_area:=x;
  70.         exit
  71.         end;
  72.       x:=x+1
  73.       end;
  74.     mouse_area:=0
  75.     end;
  76.  
  77.     function mouse_swreset;
  78.     var regs:registers;
  79.     begin
  80.       regs.ax:=$21;
  81.       intr($33,regs);
  82.       mouse_swreset:=regs.ax=$ffff
  83.       end;
  84.  
  85.     procedure get_sensitivity;
  86.     var regs:registers;
  87.     begin
  88.       regs.ax:=$1b;
  89.       intr($33,regs);
  90.       x:=regs.bx;
  91.       y:=regs.cx;
  92.       speed:=regs.dx
  93.       end;
  94.  
  95.     procedure set_sensitivity;
  96.     var regs:registers;
  97.     begin
  98.       regs.ax:=$1a;
  99.       regs.bx:=x;
  100.       regs.cx:=y;
  101.       regs.dx:=speed;
  102.       intr($33,regs)
  103.       end;
  104.  
  105.     procedure physical_movement;
  106.     var regs:registers;
  107.     begin
  108.       regs.ax:=$b;
  109.       intr($33,regs);
  110.       x:=regs.cx;
  111.       y:=regs.dx
  112.       end;
  113.  
  114.     procedure set_ratio;
  115.     var regs:registers;
  116.     begin
  117.       regs.ax:=$0f;
  118.       x:=x and $7fff;
  119.       y:=y and $7fff;
  120.       regs.cx:=x;
  121.       regs.dx:=y;
  122.       intr($33,regs)
  123.       end;
  124.  
  125.     procedure cond_off;
  126.     var regs:registers;
  127.     begin
  128.       regs.ax:=$10;
  129.       regs.cx:=ux;
  130.       regs.dx:=uy;
  131.       regs.si:=lx;
  132.       regs.di:=ly;
  133.       intr($33,regs)
  134.       end;
  135.  
  136.     procedure set_speed2;
  137.     var regs: registers;
  138.     begin
  139.       regs.ax:=$13;
  140.       regs.dx:=threshold;
  141.       intr($33,regs)
  142.       end;
  143.  
  144.     function mouseparams;
  145.     var regs: registers;
  146.     begin
  147.       regs.ax:=$0;
  148.       intr($33,regs);
  149.       mouseparams:=regs.ax=$ffff;
  150.       num_buttons:=regs.bx
  151.       end;
  152.  
  153.     procedure mouse_cursor;
  154.     var regs: registers;
  155.     begin
  156.       if onoff then regs.ax:=$1 else regs.ax:=$2;
  157.       intr($33,regs)
  158.       end;
  159.  
  160.     procedure mouse_position;
  161.     var regs: registers;
  162.     begin
  163.       regs.ax:=$3;
  164.       intr($33,regs);
  165.       button_stat:=regs.bx;
  166.       x:=regs.cx;
  167.       y:=regs.dx
  168.       end;
  169.  
  170.     function mousex;
  171.     var b,x,y : word;
  172.     begin
  173.       mouse_position(b,x,y);
  174.       mousex:=x
  175.       end;
  176.  
  177.     function mousey;
  178.     var b,x,y : word;
  179.     begin
  180.       mouse_position(b,x,y);
  181.       mousey:=y
  182.       end;
  183.  
  184.     function mousebutton;
  185.     var b,x,y : word;
  186.     begin
  187.       mouse_position(b,x,y);
  188.       mousebutton:=b
  189.       end;
  190.  
  191.     procedure set_mouse_position;
  192.     var regs: registers;
  193.     begin
  194.       regs.ax:=$4;
  195.       regs.cx:=x;
  196.       regs.dx:=y;
  197.       intr($33,regs)
  198.       end;
  199.  
  200.     procedure set_mouse_x_bounds;
  201.     var regs: registers;
  202.     begin
  203.       regs.ax:=$7;
  204.       regs.cx:=xl;
  205.       regs.dx:=xu;
  206.       intr($33,regs)
  207.       end;
  208.  
  209.     procedure set_mouse_y_bounds;
  210.     var regs: registers;
  211.     begin
  212.       regs.ax:=$8;
  213.       regs.cx:=yl;
  214.       regs.dx:=yu;
  215.       intr($33,regs)
  216.       end;
  217.  
  218.     function button_pressed;
  219.     var regs:registers;
  220.     begin
  221.       regs.ax:=$5;
  222.       regs.bx:=button;
  223.       intr($33,regs);
  224.       count:=regs.bx;
  225.       x:=regs.cx;
  226.       y:=regs.dx;
  227.       button_pressed:=(regs.ax=1)
  228.       end;
  229.  
  230.     function mouse_clicked;
  231.     var trash1 : boolean;
  232.         count : word;
  233.     begin
  234.       trash1:=button_pressed(button,count,mouse_clicked_x,mouse_clicked_y);
  235.       mouse_clicked:=count>0
  236.       end;
  237.  
  238.  
  239.  
  240.  
  241.     function button_released;
  242.     var regs:registers;
  243.     begin
  244.       regs.ax:=$5;
  245.       regs.bx:=button;
  246.       intr($33,regs);
  247.       count:=regs.bx;
  248.       x:=regs.cx;
  249.       y:=regs.dx;
  250.       button_released:=(regs.ax=0)
  251.       end;
  252.  
  253.     procedure set_mouse_cursor;
  254.     var regs : registers;
  255.     begin
  256.       regs.ax:=$9;
  257.       regs.bx:=x;
  258.       regs.cx:=y;
  259.       regs.es:=seg(point[0]);
  260.       regs.dx:=ofs(point[0]);
  261.       intr($33,regs)
  262.       end;
  263.  
  264.     procedure set_text_cursor;
  265.     var regs:registers;
  266.     begin
  267.       regs.ax:=$0a;
  268.       regs.bx:=aorh;
  269.       if aorh=0 then begin
  270.         startof:=startof or $00ff;
  271.         endof:=endof and $ff00
  272.         end;
  273.       regs.cx:=startof;
  274.       regs.dx:=endof;
  275.       intr($33,regs)
  276.       end;
  277.  
  278.     end.